home *** CD-ROM | disk | FTP | other *** search
/ CrystalVision Software Se… Wiki Wonder - Wikipedia / CrystalVision Software Services 703: The Wiki Wonder - Wikipedia.iso / 0703 / Educate / Complete Calc / Setup.exe / lib / tk / tk.tcl < prev    next >
Encoding:
Text File  |  2006-10-25  |  9.5 KB  |  420 lines
  1.  
  2. package require -exact Tk 8.4
  3. package require -exact Tcl 8.4
  4.  
  5. namespace eval ::tk {
  6. namespace eval msgcat {
  7. namespace export mc mcmax
  8. if {[interp issafe] || [catch {package require msgcat}]} {
  9. proc mc {src args} {
  10. return [eval [list format $src] $args]
  11. }
  12. proc mcmax {args} {
  13. set max 0
  14. foreach string $args {
  15. set len [string length $string]
  16. if {$len>$max} {
  17. set max $len
  18. }
  19. }
  20. return $max
  21. }
  22. } else {
  23. namespace import ::msgcat::mc
  24. namespace import ::msgcat::mcmax
  25. ::msgcat::mcload [file join $::tk_library msgs]
  26. }
  27. }
  28. namespace import ::tk::msgcat::*
  29. }
  30.  
  31.  
  32. if {[info exists ::auto_path] && [string compare {} $::tk_library] &&  [lsearch -exact $::auto_path $::tk_library] < 0} {
  33. lappend ::auto_path $::tk_library
  34. }
  35.  
  36.  
  37. set ::tk_strictMotif 0
  38.  
  39.  
  40. catch {tk useinputmethods 1}
  41.  
  42. proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
  43. wm withdraw $w
  44. update idletasks
  45. set checkBounds 1
  46. if {$place eq ""} {
  47. set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
  48. set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
  49. set checkBounds 0
  50. } elseif {[string equal -len [string length $place] $place "pointer"]} {
  51. if {[string equal -len [string length $anchor] $anchor "center"]} {
  52. set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
  53. set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
  54. } else {
  55. set x [winfo pointerx $w]
  56. set y [winfo pointery $w]
  57. }
  58. } elseif {[string equal -len [string length $place] $place "widget"] &&  [winfo exists $anchor] && [winfo ismapped $anchor]} {
  59. set x [expr {[winfo rootx $anchor] +  ([winfo width $anchor]-[winfo reqwidth $w])/2}]
  60. set y [expr {[winfo rooty $anchor] +  ([winfo height $anchor]-[winfo reqheight $w])/2}]
  61. } else {
  62. set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
  63. set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
  64. set checkBounds 0
  65. }
  66. if {[tk windowingsystem] eq "win32"} {
  67. set checkBounds 0
  68. }
  69. if {$checkBounds} {
  70. if {$x < 0} {
  71. set x 0
  72. } elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
  73. set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
  74. }
  75. if {$y < 0} {
  76. set y 0
  77. } elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
  78. set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
  79. }
  80. if {[tk windowingsystem] eq "macintosh"  || [tk windowingsystem] eq "aqua"} {
  81. if {$y < 20} { set y 20 }
  82. }
  83. }
  84. wm geometry $w +$x+$y
  85. wm deiconify $w
  86. }
  87.  
  88. proc ::tk::SetFocusGrab {grab {focus {}}} {
  89. set index "$grab,$focus"
  90. upvar ::tk::FocusGrab($index) data
  91.  
  92. lappend data [focus]
  93. set oldGrab [grab current $grab]
  94. lappend data $oldGrab
  95. if {[winfo exists $oldGrab]} {
  96. lappend data [grab status $oldGrab]
  97. }
  98. catch {grab $grab}
  99. if {[winfo exists $focus]} {
  100. focus $focus
  101. }
  102. }
  103.  
  104. proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
  105. set index "$grab,$focus"
  106. if {[info exists ::tk::FocusGrab($index)]} {
  107. foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
  108. unset ::tk::FocusGrab($index)
  109. } else {
  110. set oldGrab ""
  111. }
  112.  
  113. catch {focus $oldFocus}
  114. grab release $grab
  115. if {[string equal $destroy "withdraw"]} {
  116. wm withdraw $grab
  117. } else {
  118. destroy $grab
  119. }
  120. if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
  121. if {[string equal $oldStatus "global"]} {
  122. grab -global $oldGrab
  123. } else {
  124. grab $oldGrab
  125. }
  126. }
  127. }
  128.  
  129. if {[string equal $tcl_platform(platform) "unix"]} {
  130. proc ::tk::GetSelection {w {sel PRIMARY}} {
  131. if {[catch {selection get -displayof $w -selection $sel  -type UTF8_STRING} txt]  && [catch {selection get -displayof $w -selection $sel} txt]} {
  132. return -code error "could not find default selection"
  133. } else {
  134. return $txt
  135. }
  136. }
  137. } else {
  138. proc ::tk::GetSelection {w {sel PRIMARY}} {
  139. if {[catch {selection get -displayof $w -selection $sel} txt]} {
  140. return -code error "could not find default selection"
  141. } else {
  142. return $txt
  143. }
  144. }
  145. }
  146.  
  147.  
  148. proc ::tk::ScreenChanged screen {
  149. set x [string last . $screen]
  150. if {$x > 0} {
  151. set disp [string range $screen 0 [expr {$x - 1}]]
  152. } else {
  153. set disp $screen
  154. }
  155.  
  156. uplevel #0 upvar #0 ::tk::Priv.$disp ::tk::Priv
  157. variable ::tk::Priv
  158. global tcl_platform
  159.  
  160. if {[info exists Priv]} {
  161. set Priv(screen) $screen
  162. return
  163. }
  164. array set Priv {
  165. activeMenu    {}
  166. activeItem    {}
  167. afterId        {}
  168. buttons        0
  169. buttonWindow    {}
  170. dragging    0
  171. focus        {}
  172. grab        {}
  173. initPos        {}
  174. inMenubutton    {}
  175. listboxPrev    {}
  176. menuBar        {}
  177. mouseMoved    0
  178. oldGrab        {}
  179. popup        {}
  180. postedMb    {}
  181. pressX        0
  182. pressY        0
  183. prevPos        0
  184. selectMode    char
  185. }
  186. set Priv(screen) $screen
  187. set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
  188. set Priv(window) {}
  189. }
  190.  
  191.  
  192. tk::ScreenChanged [winfo screen .]
  193.  
  194.  
  195. proc ::tk::EventMotifBindings {n1 dummy dummy} {
  196. upvar $n1 name
  197.  
  198. if {$name} {
  199. set op delete
  200. } else {
  201. set op add
  202. }
  203.  
  204. event $op <<Cut>> <Control-Key-w>
  205. event $op <<Copy>> <Meta-Key-w>
  206. event $op <<Paste>> <Control-Key-y>
  207. event $op <<Undo>> <Control-underscore>
  208. }
  209.  
  210.  
  211. if {[string equal [info commands tk_chooseColor] ""]} {
  212. proc ::tk_chooseColor {args} {
  213. return [eval tk::dialog::color:: $args]
  214. }
  215. }
  216. if {[string equal [info commands tk_getOpenFile] ""]} {
  217. proc ::tk_getOpenFile {args} {
  218. if {$::tk_strictMotif} {
  219. return [eval tk::MotifFDialog open $args]
  220. } else {
  221. return [eval ::tk::dialog::file:: open $args]
  222. }
  223. }
  224. }
  225. if {[string equal [info commands tk_getSaveFile] ""]} {
  226. proc ::tk_getSaveFile {args} {
  227. if {$::tk_strictMotif} {
  228. return [eval tk::MotifFDialog save $args]
  229. } else {
  230. return [eval ::tk::dialog::file:: save $args]
  231. }
  232. }
  233. }
  234. if {[string equal [info commands tk_messageBox] ""]} {
  235. proc ::tk_messageBox {args} {
  236. return [eval tk::MessageBox $args]
  237. }
  238. }
  239. if {[string equal [info command tk_chooseDirectory] ""]} {
  240. proc ::tk_chooseDirectory {args} {
  241. return [eval ::tk::dialog::file::chooseDir:: $args]
  242. }
  243. }
  244.  
  245.  
  246. switch [tk windowingsystem] {
  247. "x11" {
  248. event add <<Cut>> <Control-Key-x> <Key-F20>
  249. event add <<Copy>> <Control-Key-c> <Key-F16>
  250. event add <<Paste>> <Control-Key-v> <Key-F18>
  251. event add <<PasteSelection>> <ButtonRelease-2>
  252. event add <<Undo>> <Control-Key-z>
  253. event add <<Redo>> <Control-Key-Z>
  254. catch { event add <<PrevWindow>> <ISO_Left_Tab> }
  255. catch { event add <<PrevWindow>> <hpBackTab> }
  256.  
  257. trace variable ::tk_strictMotif w ::tk::EventMotifBindings
  258. set ::tk_strictMotif $::tk_strictMotif
  259. }
  260. "win32" {
  261. event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
  262. event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
  263. event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
  264. event add <<PasteSelection>> <ButtonRelease-2>
  265. event add <<Undo>> <Control-Key-z>
  266. event add <<Redo>> <Control-Key-y>
  267. }
  268. "aqua" {
  269. event add <<Cut>> <Command-Key-x> <Key-F2>
  270. event add <<Copy>> <Command-Key-c> <Key-F3>
  271. event add <<Paste>> <Command-Key-v> <Key-F4>
  272. event add <<PasteSelection>> <ButtonRelease-2>
  273. event add <<Clear>> <Clear>
  274. event add <<Undo>> <Command-Key-z>
  275. event add <<Redo>> <Command-Key-y>
  276. }
  277. "classic" {
  278. event add <<Cut>> <Control-Key-x> <Key-F2>
  279. event add <<Copy>> <Control-Key-c> <Key-F3>
  280. event add <<Paste>> <Control-Key-v> <Key-F4>
  281. event add <<PasteSelection>> <ButtonRelease-2>
  282. event add <<Clear>> <Clear>
  283. event add <<Undo>> <Control-Key-z> <Key-F1>
  284. event add <<Redo>> <Control-Key-Z>
  285. }
  286. }
  287.  
  288. if {$::tk_library ne ""} {
  289. if {[string equal $tcl_platform(platform) "macintosh"]} {
  290. proc ::tk::SourceLibFile {file} {
  291. if {[catch {
  292. namespace eval ::  [list source [file join $::tk_library $file.tcl]]
  293. }]} {
  294. namespace eval :: [list source -rsrc $file]
  295. }
  296. }
  297. } else {
  298. proc ::tk::SourceLibFile {file} {
  299. namespace eval :: [list source [file join $::tk_library $file.tcl]]
  300. }
  301. }
  302. namespace eval ::tk {
  303. SourceLibFile button
  304. SourceLibFile entry
  305. SourceLibFile listbox
  306. SourceLibFile menu
  307. SourceLibFile panedwindow
  308. SourceLibFile scale
  309. SourceLibFile scrlbar
  310. SourceLibFile spinbox
  311. SourceLibFile text
  312. }
  313. }
  314.  
  315. event add <<PrevWindow>> <Shift-Tab>
  316. bind all <Tab> {tk::TabToWindow [tk_focusNext %W]}
  317. bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
  318.  
  319.  
  320. proc ::tk::CancelRepeat {} {
  321. variable ::tk::Priv
  322. after cancel $Priv(afterId)
  323. set Priv(afterId) {}
  324. }
  325.  
  326.  
  327. proc ::tk::TabToWindow {w} {
  328. if {[string equal [winfo class $w] Entry]  || [string equal [winfo class $w] Spinbox]} {
  329. $w selection range 0 end
  330. $w icursor end
  331. }
  332. focus $w
  333. }
  334.  
  335. proc ::tk::UnderlineAmpersand {text} {
  336. set idx [string first "&" $text]
  337. if {$idx >= 0} {
  338. set underline $idx
  339. while {[string match "&" [string index $text [expr {$idx + 1}]]]} {
  340. set base [expr {$idx + 2}]
  341. set idx  [string first "&" [string range $text $base end]]
  342. if {$idx < 0} {
  343. break
  344. } else {
  345. set underline [expr {$underline + $idx + 1}]
  346. incr idx $base
  347. }
  348. }
  349. }
  350. if {$idx >= 0} {
  351. regsub -all -- {&([^&])} $text {\1} text
  352. }
  353. return [list $text $idx]
  354. }
  355.  
  356. proc ::tk::SetAmpText {widget text} {
  357. foreach {newtext under} [::tk::UnderlineAmpersand $text] {
  358. $widget configure -text $newtext -underline $under
  359. }
  360. }
  361.  
  362. proc ::tk::AmpWidget {class path args} {
  363. set wcmd [list $class $path]
  364. foreach {opt val} $args {
  365. if {[string equal $opt {-text}]} {
  366. foreach {newtext under} [::tk::UnderlineAmpersand $val] {
  367. lappend wcmd -text $newtext -underline $under
  368. }
  369. } else {
  370. lappend wcmd $opt $val
  371. }
  372. }
  373. eval $wcmd
  374. if {$class=="button"} {
  375. bind $path <<AltUnderlined>> [list $path invoke]
  376. }
  377. return $path
  378. }
  379.  
  380. proc ::tk::FindAltKeyTarget {path char} {
  381. switch [winfo class $path] {
  382. Button -
  383. Label {
  384. if {[string equal -nocase $char  [string index [$path cget -text]  [$path cget -underline]]]} {return $path} else {return {}}
  385. }
  386. default {
  387. foreach child  [concat [grid slaves $path]  [pack slaves $path]  [place slaves $path] ] {
  388. if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} {
  389. return $target
  390. }
  391. }
  392. }
  393. }
  394. return {}
  395. }
  396.  
  397. proc ::tk::AltKeyInDialog {path key} {
  398. set target [::tk::FindAltKeyTarget $path $key]
  399. if { $target == ""} return
  400. event generate $target <<AltUnderlined>>
  401. }
  402.  
  403.  
  404. proc ::tk::mcmaxamp {args} {
  405. set maxlen 0
  406. foreach arg $args {
  407. set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]
  408. if {$length>$maxlen} {
  409. set maxlen $length
  410. }
  411. }
  412. return $maxlen
  413. }
  414.  
  415. if {[string equal [tk windowingsystem] "aqua"]} {
  416. namespace eval ::tk::mac {
  417. set useCustomMDEF 0
  418. }
  419. }
  420.